home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
ada
/
gwuada_9.zip
/
12B.C
< prev
next >
Wrap
C/C++ Source or Header
|
1993-07-27
|
40KB
|
1,234 lines
/*
* Copyright (C) 1985-1992 New York University
*
* This file is part of the Ada/Ed-C system. See the Ada/Ed README file for
* warranty (none) and distribution info and also the GNU General Public
* License for more details.
*/
/* chapter 12, part b */
#include "hdr.h"
#include "vars.h"
#include "libp.h"
#include "librp.h"
#include "miscp.h"
#include "smiscp.h"
#include "dclmapp.h"
#include "sspansp.h"
#include "errmsgp.h"
#include "nodesp.h"
#include "setp.h"
#include "chapp.h"
static void update_one_entry(Symbol, Symbol, Symbolmap);
static void update_scalar_signature(Symbol, Symbol);
static void update_record_entry(Symbol, Symbol, Symbolmap);
static void update_array_entry(Symbol, Symbol, Symbolmap);
static Node update_new_node(Node);
static Symbol update_new_name(Symbolmap, Symbol);
static void instantiate_derived_types(Node, Symbolmap);
static Set update_overloads(Set, Symbolmap);
static int check_recursive_instance(Node);
static int scan_instance(Node);
static void nodemap_free(Nodemap);
static Node nodemap_get(Nodemap, Node);
static void nodemap_put(Nodemap, Node, Node);
void instantiate_subprog_tree(Node node, Symbolmap type_map)
/*;instantiate_subprog_tree*/
{
/* Build the tree for the instantiated object, and the corresponding
* symbol table entries, some of which may contain pointers to new tree.
*/
Node id_node, gen_node, b_node, specs_node;
Symbol prog_name, gen_name, g_p, new_p;
/* Nodemap node_map; */
Tuple sig, itup, packs;
Node stmts_node, decl_node, handler_node;
Symbolmap rename_map;
Tuple truly_renamed;
Fortup ft1;
id_node = N_AST1(node);
gen_node = N_AST2(node);
prog_name = N_UNQ(id_node);
gen_name = N_UNQ(gen_node);
/* instantiate all entities local to the subprogram. The type map is aug-
* mented with the mapping of local generic entities into their instances
*/
itup = instantiate_symbtab(gen_name, prog_name, type_map);
rename_map = (Symbolmap) itup[1];
packs = (Tuple)itup[2];
truly_renamed = (Tuple) itup[3];
/* Now use this mapping to instantiate the AST itself. */
node_map = nodemap_new(); /* global object. */
current_node = node;
sig = SIGNATURE(gen_name);
b_node = (Node) sig[3];
retrieve_generic_tree(b_node, (Node)0); /* if in another file. */
/* Instantiate body and transform into subprogram node*/
specs_node = N_AST1(b_node);
decl_node = N_AST2(b_node);
stmts_node = N_AST3(b_node);
handler_node = N_AST4(b_node);
N_KIND(node) = as_subprogram;
N_AST1(node) = instantiate_tree(specs_node, rename_map);
N_AST2(node) = instantiate_tree(decl_node, rename_map);
N_AST3(node) = instantiate_tree(stmts_node, rename_map);
N_AST4(node) = instantiate_tree(handler_node, rename_map);
/* Finally, complete the instantiation of the symbol table. The later
* happens after tree instantiation, to insure that symbtab instances
* point to the instantiated nodes. The entry for the instance has been
* constructed by chain_overloads, and is not updated further.
*/
truly_renamed = tup_with(truly_renamed, (char *) gen_name);
update_symbtab_nodes(rename_map, truly_renamed);
/* Update the private declarations of enclosed packages */
FORTUP(g_p=(Symbol), packs, ft1);
new_p = symbolmap_get(rename_map, g_p);
private_decls(new_p) = (Set) update_private_decls(g_p, rename_map);
ENDFORTUP(ft1);
instantiate_derived_types(decl_node, rename_map);
/*TBSL: should we free old node_map??? ds 7nov */
nodemap_free(node_map); /* free current allocation */
node_map = nodemap_new(); /* discard after use. */
}
void instantiate_pack_tree(Node node, Symbolmap type_map,
Tuple instance_list) /*;instantiate_pack_tree*/
{
/* Build tree for instantiated object, and symbol table entries for all
* its local entities. In the case of a forward instantiation, visibility
* rules require that the symbol table of the visible part be fully
* instantiated. The expander then instantiates the symbol table for the
* body, together with the corresponding tree.
*/
Node id_node, gen_node;
Symbol package, gen_name, g_p, new_p, new_f, sym, gen_formal, over;
/* Nodemap node_map; */
Tuple sig;
Node priv_node, decl_node, b_node, spec_node, new_decl_node;
Node new_priv_node;
Node new_b_node;
Symbolmap rename_map;
Tuple ltup, itup, truly_renamed;
Tuple packs, gen_tup, gen_list;
Fortup ft1, ft2;
Forset fs1, fs2;
Set overloadables;
id_node = N_AST1(node);
gen_node = N_AST2(node);
package = N_UNQ(id_node);
gen_name = N_UNQ(gen_node);
/* Instantiate all entities local to the package. */
itup = instantiate_symbtab(gen_name, package, type_map);
rename_map = (Symbolmap)itup[1];
packs = (Tuple)itup[2];
truly_renamed = (Tuple) itup[3];
tup_free(itup); /* itup just used to pass result*/
/* Now instantiate the AST itself, and complete the instantiation of the
* symbol table.
*/
node_map = nodemap_new(); /* global object.*/
current_node = node;
sig = SIGNATURE(gen_name);
decl_node = (Node) sig[2];
priv_node = (Node) sig[3];
retrieve_generic_tree(decl_node, priv_node);
b_node = (Node) sig[4];
spec_node = node_new(as_package_spec);
new_decl_node = instantiate_tree(decl_node, rename_map);
new_priv_node = instantiate_tree(priv_node, rename_map);
/* N_LIST(new_decl_node) = instance_list + N_LIST(new_decl_node); */
N_LIST(new_decl_node) = tup_add(instance_list, N_LIST(new_decl_node));
N_AST1(spec_node) = id_node;
N_AST2(spec_node) = new_decl_node;
N_AST3(spec_node) = new_priv_node;
if (b_node != OPT_NODE) { /* Instantiate body as well */
retrieve_generic_tree(b_node, (Node)0);
new_b_node = instantiate_tree(b_node, rename_map);
N_KIND(new_b_node) = as_package_body;
}
else {
new_b_node = copy_node(node);
/* Attach tpe_map to node for eventual code emission */
ltup = tup_new(2);
ltup[1] = (char *) rename_map;
ltup[2] = (char *) needs_body(gen_name);
N_AST4(new_b_node) = new_instance_node(ltup);
}
/* In any case, emit the spec node before the body */
make_insert_node(node, tup_new1((char *) spec_node), new_b_node);
/* Node references in the symbol table must point to the instantiated
* tree.
*/
update_symbtab_nodes(rename_map, truly_renamed);
/* Complete construction of visibility information for inner packages. */
FORTUP(g_p=(Symbol), packs, ft1);
new_p = symbolmap_get(rename_map, g_p);
/* construct visible map for it, so that the proper instantiated
* entities within new package become accessible.
*/
/* TBSL: review translation of next line */
/*
* visible(new_p) := { [id, symbolmap_get(rename_map, old_n) ? old_n] :
* [id, old_n] in visible(g_p)};
*/
/*
* Nested packages (which are not generic) are now visible: their
* local entities are nameable using qualified names.
*/
if (NATURE(g_p) != na_generic_package
&& NATURE(g_p) != na_generic_package_spec) {
vis_mods = tup_with(vis_mods, (char *) new_p);
}
/*
*The top level package is added to vis_mods in end_specs, called
* at the end of package_instance.
*/
/* Finally, apply renamings to the private declarations. */
private_decls(new_p) = (Set) update_private_decls(g_p, rename_map);
ENDFORTUP(ft1);
instantiate_derived_types(decl_node, rename_map);
/* The instantiation does not include a copy of the generic part. RM 12.3(5)
* Thus, the instantiation of the generic parameters themselves, is not
* visible. If, however, a generic subprogram parameter has an overload in
* the visible part of the package, that overload itself must remain
* accessible; so we just remove the name of the instantiated generic
* subprogram parameter from its own overloads set.
*/
overloadables = set_new(0);
gen_list = (Tuple) SIGNATURE(gen_name)[1];
FORTUP(gen_tup = (Tuple), gen_list, ft2);
gen_formal = (Symbol) gen_tup[1];
new_f = symbolmap_get(rename_map, gen_formal);
if (new_f == (Symbol) 0) /* error in instantiation */
/* TBSL: can we just return here ? */
continue;
if (NATURE(gen_formal)==na_procedure || NATURE(gen_formal)==na_function)
overloadables = set_with(overloadables, (char *) new_f);
ENDFORTUP(ft2);
FORSET(sym=(Symbol), overloadables, fs1);